home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / patterns.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  3.1 KB  |  112 lines
  1. 10  ' ###################################list
  2. 20  ' PATTERNS    ED DAVIS 1-2-82
  3. 30  ' Comments welcome
  4. 40  ' but BE  KIND!
  5. 50  ' Burlington (8-446)-2091
  6. 60  '
  7. 70  ' ###################################
  8. 100  KEY OFF:SCREEN 0,1:COLOR 15,0,0:WIDTH 40:CLS:M%=0
  9. 110  LOCATE 10,1:PRINT "<<-  IF THIS PRINTING IS NOT IN THE  ->>"
  10. 120  LOCATE 11,1:PRINT "   CENTER OF THE SCREEN PRESS  'M' TO
  11. 130  LOCATE 12,1:PRINT "   MOVE THE PICTURE TO THE RIGHT, ANY
  12. 140  LOCATE 13,1:PRINT "    OTHER KEY TO GO TO THE PROGRAM.
  13. 150  K$=INKEY$:IF K$="" GOTO 150
  14. 160  IF K$="M" OR K$="m" THEN OUT 980,2: OUT 981,43:M%=1:GOTO 200
  15. 170  M%=0
  16. 200  CLS
  17. 210  COLOR 23 :LOCATE 2,13:PRINT"PATTERNS"
  18. 215  LOCATE 3,13:PRINT"E.DAVIS
  19. 220  COLOR  4,7,0:LOCATE 6,2:PRINT"Please select one of the following:
  20. 240  LOCATE 8,9: PRINT"1- WALLPAPER (NICE!)
  21. 250  LOCATE 9,9:PRINT"2- WAVES
  22. 260  LOCATE 10,9:PRINT "3- ALPHA PARTICLE
  23. 270  LOCATE 11,9:PRINT "4- FACE
  24. 300  LOCATE 21,9:PRINT "0- TO SWITCH TO/FROM DISPLAYS
  25. 310  LOCATE 22,9:PRINT "Q- TO QUIT PROGRAM
  26. 320  LOCATE 23,9:PRINT "M- TO MOVE SCREEN"
  27. 390  LOCATE 4,16
  28. 400  K$=INKEY$:IF K$="" GOTO 400
  29. 410  IF K$="0" THEN GOSUB 65000
  30. 420  IF K$="1" THEN GOSUB 500
  31. 430  IF K$="2" THEN GOSUB 600
  32. 440  IF K$="3" THEN GOSUB 700
  33. 450  IF K$="4" THEN GOTO 800
  34. 490  IF K$="Q" OR K$="q" THEN CLS:END
  35. 495  IF K$="M" OR K$="m" THEN GOTO 100
  36. 499  GOTO 200
  37. 500  CLS :REM BEGINNING OF PATTERN PGMS E.DAVIS 1-2-82
  38. 510  SCREEN 1,0:COLOR 0,1:IF M%=1 THEN OUT 980,2:OUT 981,43
  39. 520  FOR I=0 TO 300:C=C+1:C=C-(3*INT(C/3)):IF C>3 THEN C=0
  40. 530  LINE (I,0)-(300-I,191),C:NEXT
  41. 540  FOR I=0 TO 191:C=C+1:C=C-(3*INT(C/3)):IF C>3 THEN C=0
  42. 550  LINE (0,191-I)-(300,I),C:NEXT I:GOSUB 2000:GOTO 500
  43. 600  CLS ' WAVES
  44. 610  SCREEN 1,0:COLOR 0,1:IF M%=1 THEN OUT 980,2:OUT 981,43
  45. 620   C=3:LC=0:T#=18.8496
  46. 630  FOR X=0 TO T# STEP T#/279:LINE (140,96)-(X*14.8,60*SIN(X)+96),C
  47. 640  NEXT :GOSUB 2000:GOTO 600
  48. 700  CLS' ALPHA PARTICLES
  49. 710  SCREEN 1,0:COLOR 1,0:IF M%=1 THEN OUT 980,2:OUT 981,43
  50. 715  CLS
  51. 720  FOR J=1 TO 150:SOUND RND*2000+1037,2:X=INT(RND(1)*277):Y=INT(RND(1)*151)
  52. 730  LINE (140,96)-(X,Y),C:C=INT (RND(1)*3):NEXT J:GOSUB 2000:GOTO 700
  53. 800  CLS:IF PIC=1 THEN GOTO 804
  54. 801  PIC=1
  55. 802  S=3.142*235/180:F=3.142*305/180:DIM FF%(600):DIM FS%(600)
  56. 804  SCREEN 1,0:COLOR 4,7
  57. 806  CIRCLE (160,30),100,2,S,F,1
  58. 808  CIRCLE (160,100),50,2
  59. 810  PAINT (160,140),3,2
  60. 812  CIRCLE (160,170),100,2,S-3.142,F-3.142,1
  61. 814  PAINT (160,65),3,2
  62. 816  GET(115,115)-(205,145),FS%
  63. 818  GET (115,55)-(205,88),FF%
  64. 820  CLS
  65. 822  CIRCLE (160,100),90,2
  66. 824  PAINT (100,100),2,2
  67. 826  CIRCLE (120,75),11,1,,,1.1
  68. 828  PAINT (120,65),1,1
  69. 830  CIRCLE(200,75),11,1,,,1.1
  70. 832  PAINT (200,65),1,1
  71. 834  PRESET (120,40):DRAW "C1S4F11D1H11G11D1E11F11"
  72. 836  PRESET (200,40):DRAW "C1S4F11D1H11G11D1E11F11"
  73. 838  PUT (115,115),FS%
  74. 840  KEY OFF:LOCATE 25,10:PRINT "PRESS ANY KEY FOR MENU";
  75. 842  FOR I=1 TO 1000:NEXT I:PUT (115,115),FS%:PUT (115,115),FF%:GOSUB 846
  76. 844  FOR I=1 TO 600:NEXT I:PUT (115,115),FF%:PUT (115,115),FS%:GOSUB 846:GOTO 842
  77. 846  K$=INKEY$: IF K$="" THEN RETURN
  78. 848  GOTO 200
  79. 2000  ' ROUTINE TO REPEAT OR RETURN
  80. 2010  KEY OFF:LOCATE 25,2:PRINT " 'R' TO REPEAT, OTHER KEY TO RETURN";
  81. 2015  LOCATE 1,1
  82. 2020  K$=INKEY$:IF K$="" GOTO 2020
  83. 2030  IF K$="R" OR K$="r" THEN RETURN
  84. 2040  RETURN 200
  85. 65000  ' COLOR MONITOR-MONOCHROME MONITOR SWITCH    EMD 11-81
  86. 65001  CLS
  87. 65002  PRINT:PRINT"IF YOU WANT TO TOGGLE MONOCHROME/COLOR  THEN;"
  88. 65003  PRINT"   FOR COLOR PRESS - C"
  89. 65004  PRINT"   FOR MONO  PRESS - M"
  90. 65005  PRINT"   FOR NO CHANGE PRESS ANY OTHER KEY."
  91. 65006  K$=INKEY$:IF K$="" GOTO 65006
  92. 65007  IF K$="C" OR K$="c" THEN GOSUB 65019:RETURN
  93. 65008  IF K$="M" OR K$="m" THEN GOSUB 65011:RETURN
  94. 65009  CLS
  95. 65010  PRINT"@@@@@@@@@@@@    NO CHANGE   @@@@@@@@@@@@@@":RETURN
  96. 65011  REM switch to monochrome adapter
  97. 65012  DEF SEG=0
  98. 65013  POKE &H410,(PEEK(&H410) OR &H30)
  99. 65014  DEF SEG
  100. 65015  LOCATE ,,1,12,13
  101. 65016  SCREEN 0
  102. 65017  WIDTH 80
  103. 65018  RETURN
  104. 65019  REM switch to color/graphics adapter
  105. 65020  DEF SEG=0
  106. 65021  POKE &H410,(PEEK(&H410) AND &HCF) OR &H20
  107. 65022  DEF SEG
  108. 65023  LOCATE ,,1,6,7
  109. 65024  SCREEN 0
  110. 65025  WIDTH 40
  111. 65026  RETURN
  112.